home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 44 / Amiga Format CD44 (1999-08-26)(Future Publishing)(GB)(Track 1 of 3)[!][issue 1999-10].iso / -in_the_mag- / basics / amos / moreuselssprgs.lha / Earth.AMOS / Earth.amosSourceCode
AMOS Source Code  |  1997-04-18  |  5KB  |  174 lines
  1. Set Buffer 120
  2. NAM$=Command Line$
  3. Screen Open 0,320,256,8,0
  4. Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  5. For A=1 To 7 : Colour A,A*$222 : Next 
  6. Double Buffer : Autoback 0
  7. AX=0 : AY=0 : AZ=65 : PIC=0
  8. DZ=4000
  9. MAS=1100
  10. Dim SBUF$(MAS)
  11. T=0 : TIM=0 : ST1=32 : ST2=32 : ST3=32
  12. Repeat 
  13.   Screen Swap : Wait Vbl 
  14.    Extension_8_121C 0,0
  15.    Extension_8_1138 AX,AY,AZ
  16.    Extension_8_1122 0,0,DZ
  17.    Extension_8_1152 
  18.    Extension_8_121C 0,1
  19.   If TIM Then Dec TIM : If TIM=0 Then Inc T
  20.   If T=0
  21.     If TIM
  22.       Add AX,1
  23.     End If 
  24.      Extension_8_121C 0,2
  25.      Extension_8_1258 
  26.     Add WX,4
  27.     Gosub DTEARTH
  28.     If DZ>300
  29.       Add DZ,-20
  30.     Else 
  31.       If TIM=0 : TIM=100 : End If 
  32.       If TIM=80 : ST1=16 : End If 
  33.       If TIM=70 : ST2=32 : End If 
  34.       If TIM=60 : ST1=8 : End If 
  35.       If TIM=50 : ST2=16 : End If 
  36.       If TIM=40 : ST1=4 : End If 
  37.       If TIM=30 : ST2=8 : End If 
  38.       If TIM=20 : ST1=2 : End If 
  39.       If TIM=10 : ST2=4 : End If 
  40.     End If 
  41.   End If 
  42.   If T=1
  43.     If TIM=0 : TIM=100 : ST1=32 : ST2=64 : End If 
  44.     If TIM=80 : ST2=32 : End If 
  45.     If TIM=60 : ST1=16 : End If 
  46.     If TIM=40 : ST2=16 : End If 
  47.     If TIM=20 : ST1=8 : End If 
  48.      Extension_8_121C 0,2
  49.      Extension_8_1258 
  50.     Add WX,3
  51.     Add AX,2
  52.     Add AY,1
  53.     Gosub LINEEARTH
  54.   End If 
  55.   If T=2
  56.     If TIM=0 : TIM=500 : End If 
  57.      Extension_8_121C 0,2
  58.      Extension_8_1258 
  59.     Add WX,2
  60.     Add AX,3
  61.     Add AY,2
  62.     Add AZ,1
  63.     Gosub AREAEARTH
  64.   End If 
  65.   If T=3
  66.      Extension_8_121C 0,2
  67.      Extension_8_1258 
  68.     Add WX,3
  69.     Add AX,2
  70.     Add AZ,1
  71.     Gosub AREAEARTH
  72.     Add DZ,50
  73.   End If 
  74.   If NAM$<>"" Then Save Iff NAM$+ Extension_8_0EB8(PIC,3) : Inc PIC
  75. Until DZ=4000
  76. End 
  77. DTEARTH:
  78.   A=0
  79.   For Y=-248 To 248 Step ST1
  80.     Add A,ST1
  81.     If(A mod 32)=0 Then ST=ST2 Else ST=64
  82.     For X=WX To 1023+WX Step ST
  83.       R= Extension_8_1114(Y,100)
  84.       XX= Extension_8_1106(X,R) : ZZ= Extension_8_1114(X,R)
  85.       YY= Extension_8_1106(Y,100)
  86.       Z2= Extension_8_11C4(XX,YY,ZZ)-DZ
  87.       C=(100-Z2)/26
  88.       If C>-1
  89.         X2= Extension_8_1168 +160
  90.         Y2= Extension_8_1184 +128
  91.         If Extension_8_039E(X2,Y2)<C
  92.            Extension_8_0388 X2,Y2,C
  93.         End If 
  94.       End If 
  95.     Next 
  96.   Next 
  97. Return 
  98. LINEEARTH:
  99.   For Y=-256 To 256 Step ST1
  100.     OX1=0 : OY1=0 : OX2=0 : OY2=0
  101.     For X=WX To 1024+WX Step ST2
  102.       R= Extension_8_1114(Y,100)
  103.       XX= Extension_8_1106(X,R) : ZZ= Extension_8_1114(X,R)
  104.       YY= Extension_8_1106(Y,100)
  105.       Z2= Extension_8_11C4(XX,YY,ZZ)-DZ
  106.       X2= Extension_8_1168 +160
  107.       Y2= Extension_8_1184 +128
  108.       If OX1 or OY1
  109.         If Z2>0
  110.            Extension_8_1016 X2,Y2 To OX1,OY1,1,1
  111.         Else 
  112.            Extension_8_1016 X2,Y2 To OX1,OY1,2,2
  113.         End If 
  114.       End If 
  115.       OX1=X2 : OY1=Y2
  116.       If Y<>-248
  117.         R= Extension_8_1114(Y-ST1,100)
  118.         XX= Extension_8_1106(X,R) : ZZ= Extension_8_1114(X,R)
  119.         YY= Extension_8_1106(Y-ST1,100)
  120.         Z2= Extension_8_11C4(XX,YY,ZZ)-DZ
  121.         X2= Extension_8_1168 +160
  122.         Y2= Extension_8_1184 +128
  123.         If Z2>0
  124.            Extension_8_1016 X2,Y2 To OX1,OY1,1,1
  125.         Else 
  126.            Extension_8_1016 X2,Y2 To OX1,OY1,4,4
  127.         End If 
  128.       End If 
  129.     Next 
  130.   Next 
  131. Return 
  132. AREAEARTH:
  133.   F=0
  134.   X=Free
  135.   For Y=-256 To 256 Step ST3
  136.     OX1=0 : OY1=0 : OX2=0 : OY2=0
  137.     OX3=0 : OY3=0 : OX4=0 : OY4=0
  138.     For X=WX To 1024+WX Step ST3
  139.       R= Extension_8_1114(Y,100)
  140.       XX= Extension_8_1106(X,R) : ZZ= Extension_8_1114(X,R)
  141.       YY= Extension_8_1106(Y,100)
  142.       Z2= Extension_8_11C4(XX,YY,ZZ)-DZ
  143.       X2= Extension_8_1168 +160
  144.       Y2= Extension_8_1184 +128
  145.       If Y<>-248
  146.         R= Extension_8_1114(Y-ST3,100)
  147.         XX= Extension_8_1106(X,R) : ZZ= Extension_8_1114(X,R)
  148.         YY= Extension_8_1106(Y-ST3,100)
  149.         OZ2= Extension_8_11C4(XX,YY,ZZ)-DZ
  150.         OX3= Extension_8_1168 +160
  151.         OY3= Extension_8_1184 +128
  152.       End If 
  153.       If OX1 or OY1
  154.         If Z2<0 and OZ2<0
  155.           SBUF$(F)= Extension_8_08C4(512-Z2)+ Extension_8_08C4(X2)+ Extension_8_08C4(Y2)+ Extension_8_08C4(OX3)+ Extension_8_08C4(OY3)+ Extension_8_08C4(OX4)+ Extension_8_08C4(OY4)+ Extension_8_08C4(OX1)+ Extension_8_08C4(OY1)
  156.           Inc F
  157.         End If 
  158.       End If 
  159.       OX1=X2 : OY1=Y2
  160.       OX4=OX3 : OY4=OY3
  161.     Next 
  162.   Next 
  163.   X=Free
  164.   For A=F To MAS : SBUF$(A)= Extension_8_08C4(32678) : Next 
  165.   Sort SBUF$(0)
  166.   Set Pattern 2
  167.   For A=0 To F-1
  168.     AD=Varptr(SBUF$(A))
  169.     Z2=512-Deek(AD) : C=-Z2/7
  170.     X1=Deek(AD+2) : Y1=Deek(AD+4) : X2=Deek(AD+6) : Y2=Deek(AD+8)
  171.     X3=Deek(AD+10) : Y3=Deek(AD+12) : X4=Deek(AD+14) : Y4=Deek(AD+16)
  172.     Ink C/2,(C+1)/2 : Polygon X1,Y1 To X2,Y2 To X3,Y3 To X4,Y4
  173.   Next 
  174. Return